PC Pro 2005 June (DVD)/DPPRO0605DVD.iso/Install/program files/Borland/BDS/3.0/Demos/Delphi.Net/CLR/Remoting/uNTService.pas

Pascal/Delphi Source File | 2004-10-22 | 5.0 KB | 210 lines

unit uNTService;
//------------------------------------------------------------------------------
//  Last updated:   11/06/03
//  Author:         Dennis Passmore
//  Company:        Ultimate Software, Inc.
//  Contact info:   [e-mail]
//
//  Compatibility:  Delphi for .NET HTTP service demo
//
//  Description:    TNTKeyService class implements base .NET service class.
//                  TLockserver class implements base ILockserver which is
//                  exported via .NET Remoting
//
//------------------------------------------------------------------------------
interface

// at the time of writing this example the optimizing compiler was not functional
// and the only way to avoid code bloat was to copy specific RTL code into your
// application. This should be corrected in the final release of Delphi 8 for .NET

{$define MinEXE} // to avoid code bloat caused by using Borland.Vcl.Classes

uses
  System.IO,
  System.ServiceProcess,
  System.Runtime.Remoting,
  Borland.Vcl.SysUtils,
  uRNGintf;

type
  TNTKeyService = class(System.ServiceProcess.ServiceBase)
  strict protected
    procedure OnContinue; override;
    procedure OnPause; override;
    procedure OnShutdown; override;
    procedure OnStart(args: array of string); override;
    procedure OnStop; override;
  public
    constructor Create;
  end;

  TLockserver = class(MarshalByRefObject, ILockserver)
    function ExtendLock(const fKey: widestring): boolean;
    function Lockitem(const fItem: widestring; out fKey: widestring): boolean;
    function IsItemLocked(const fItem: widestring): boolean;
    function UnLockitem(const fKey: widestring): boolean;
  end;

  [assembly: RuntimeRequiredAttribute(TypeOf(TLockserver))]

var
  NTKeyService: TNTKeyService = nil;
  RNG: TLockserver = nil;

implementation

uses
{$ifdef MinEXE} // to avoid code bloat caused by using Borland.Vcl.Classes
  uTListImpl,
{$else}
  Borland.Vcl.Classes,
{$endif}
  uInstService;

const
  FiveMin: double = 5 * 60 / 84600;

type
  TLockItem = class
    fItem: string;
    fKey: string;
    fTime: TDateTime
  end;

var
  fLocks: TList;

constructor TNTKeyService.Create;
begin
  inherited Create;
  ServiceName         := cNTServiceProg;
  CanHandlePowerEvent := false;
  CanPauseAndContinue := false;
  CanShutdown         := true;
  CanStop             := true;
  EventLog.Source     := cNTServiceDisp;
  EventLog.Log        := 'Application';
  AutoLog := true;
end;

procedure TNTKeyService.OnContinue;
begin
  inherited; // should never be called
  //todo
end;

procedure TNTKeyService.OnPause;
begin
  inherited; // should never be called
  //todo
end;

procedure TNTKeyService.OnShutdown;
begin
  inherited;
  //todo
end;

procedure TNTKeyService.OnStart(args: array of string);
var
  configFile: string;
begin
  inherited;
  configFile := Paramstr(0) + '.config';
  if System.IO.File.Exists(configFile) then
    begin
     fLocks := TList.create;
      RemotingConfiguration.Configure(configFile);
    end
  else
    raise EAbort.Create('Operation aborted');
end;

procedure TNTKeyService.OnStop;
begin
  inherited;
  if assigned(fLocks) then
  begin
    while (fLocks.Count > 0) do
    begin
      TLockItem(fLocks.items[0]).Free;
      fLocks.Delete(0);
    end;
    fLocks.Free;
  end;
end;

function TLockserver.ExtendLock(const fKey: widestring): boolean;
var
  i: integer;
begin
  Result := false;
  i := 0;
  while (i < fLocks.Count) and (Result = false) do
  begin
    Result := TLockItem(fLocks.items[i]).fKey.Equals(fKey);
    if Result then
      TLockItem(fLocks.items[i]).fTime := System.DateTime.Now.ToOADate
    else
      inc(i);
  end;
end;

function TLockserver.Lockitem(const fItem: widestring; out fKey: widestring): boolean;
var
  fLockItem: TLockItem;
begin
  fkey := 'error';
  Result := IsItemLocked(fItem);
  if (Result = false) then
  begin
    fKey := System.Guid.Newguid.ToString;
    fLockItem := TLockItem.create;
    fLockItem.fItem := fItem;
    fLockItem.fKey  := fKey;
    fLockItem.fTime := System.DateTime.Now.ToOADate;
    Result := fLocks.add(fLockItem) >= 0;
  end;
end;

function TLockserver.IsItemLocked(const fItem: widestring): Boolean;
var
  i: integer;
  fExpires: double;
begin
  i := 0;
  fExpires := System.DateTime.Now.ToOADate - FiveMin;
  Result := false;
  while (i < fLocks.Count) and (Result = false) do
  begin
    Result := TLockItem(fLocks.items[i]).fItem.Equals(fItem);
    if Result then
    begin
      Result := TLockItem(fLocks.items[i]).fTime > fExpires;
    end;
    inc(i);
  end;
end;

function TLockserver.UnLockitem(const fKey: widestring): boolean;
var
  i: integer;
begin
  i := 0;
  Result := false;
  while (i < fLocks.Count) and (Result = false) do
  begin
    Result := TLockItem(fLocks.items[i]).fKey.Equals(fKey);
    if Result then
      begin
        TLockItem(fLocks.items[i]).Free;
        fLocks.Delete(i);
      end
    else
      inc(i);
  end;
end;

end.